Import libraries and data

rm(list=ls())

#define packages desired
dependencies <- c("tidyverse",
                  "plotly",
                  "ggmap",
                  "countrycode",
                  "lubridate",
                  "magrittr",
                  "sp",
                  "rgdal",
                  "geosphere",
                  "dismo",
                  "rgeos",
                  "leaflet",
                  "crosstalk"
                  )

#check if pacakges are installed - load if so, install+load if not)
for (i in dependencies) {
  if (i %in% row.names(installed.packages())){
    eval(bquote(library(.(i))))
    message(paste("loaded package",i))
    }  else {
    install.packages(i)
    eval(bquote(library(.(i))))
  }
}

nyc_squirrels <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-29/nyc_squirrels.csv")

Sys.setenv('MAPBOX_TOKEN'="pk.eyJ1IjoiZXdiYXJiYSIsImEiOiJjazJiMnpkMW8yNGsxM2V0Y2MzdDE3MTlxIn0.iN9sRfB1tVJmcp5rivitGw")

Data wranglin’

nyc_squirrels <- nyc_squirrels %>% mutate(date = mdy(date))
#nyc_squirrels$date <- as.character(nyc_squirrels$date)

#nyc_squirrels$shift %<>% as.factor
nyc_squirrels$primary_fur_color <-  replace(nyc_squirrels$primary_fur_color, is.na(nyc_squirrels$primary_fur_color), "unknown")

nyc_squirrels$age <- gsub("?", NA,nyc_squirrels$age, fixed=T)

Daily distribution by shift

nyc_squirrels %>% mutate(date=as.factor(date)) %>% group_by(date) %>%
  plot_mapbox(lon=~long, lat=~lat,
              color=~shift,
              text=~paste0("</br>", 
                           location, "</br>",
                           primary_fur_color, "</br>",
                           shift, "</br>"),
              colors = c('gold', 'grey4'),
              mode='markers',
              frame=~date,
              visible=T) %>%

  layout(title="Daily distribution by Shift",
    mapbox=list(
      center=list(lon=~median(long), lat=~median(lat)), 
      zoom =13, 
      bearing=-30,
      pitch=45,
      style='basic'),
    updatemenus = list(
        list(type='buttons',
                direction = "right",
                yanchor = "bottom",
                x = 1,
                y = 0,
                buttons=list(
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "basic")),
                      label = "Basic"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "dark")),
                      label = "Dark"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "satellite")),
                      label = "Satellite")
                  )
             ))
    ) %>%
  
  animation_opts(
    100, easing = "elastic", redraw = T
  ) %>%
  
     add_annotations(text = "Hold Ctrl to change pitch and bearing",
                     xref = "paper", yref = "paper",
                     x = 0, xanchor = "left",
                     y = 0, yanchor = "top",
                     legendtitle = TRUE,
                     showarrow = FALSE,
                     font = list(color = '#264E86',
                              family = 'sans serif',
                              size = 14))

Daily distribution by Primary Fur Color

nyc_squirrels %>% mutate(date=as.factor(date)) %>% group_by(date) %>%
  plot_mapbox(lon=~long, lat=~lat,
              color=~primary_fur_color,
              text=~paste0("</br>", 
                           location, "</br>",
                           primary_fur_color, "</br>",
                           shift, "</br>"),
              colors = c('grey4', 'tan3', 'grey', 'purple'),
              mode='markers',
              frame=~date,
              visible=T) %>%

  layout(title="Daily distribution by Primary Fur Color",
    mapbox=list(
      center=list(lon=~median(long), lat=~median(lat)), 
      zoom =13, 
      bearing=-30,
      pitch=45,
      style='basic'),
    updatemenus = list(
        list(type='buttons',
                direction = "right",
                yanchor = "bottom",
                x = 1,
                y = 0,
                buttons=list(
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "basic")),
                      label = "Basic"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "dark")),
                      label = "Dark"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "satellite")),
                      label = "Satellite")
                  )
             ))
    ) %>%
  
  animation_opts(
    100, easing = "elastic", redraw = T
  ) %>%
  
     add_annotations(text = "Hold Ctrl to change pitch and bearing",
                     xref = "paper", yref = "paper",
                     x = 0, xanchor = "left",
                     y = 0, yanchor = "top",
                     legendtitle = TRUE,
                     showarrow = FALSE,
                     font = list(color = '#264E86',
                              family = 'sans serif',
                              size = 14))

Daily distribution by Location

nyc_squirrels %>% mutate(date=as.factor(date)) %>% group_by(date) %>%
  plot_mapbox(lon=~long, lat=~lat,
              color=~location,
              text=~paste0("</br>", 
                           location, "</br>",
                           primary_fur_color, "</br>",
                           shift, "</br>"),
              colors = c('brown3', 'green3', 'grey'),
              mode='markers',
              frame=~date,
              visible=T) %>%

  layout(title="Daily distribution by Location",
    mapbox=list(
      center=list(lon=~median(long), lat=~median(lat)), 
      zoom =13, 
      bearing=-30,
      pitch=45,
      style='basic'),
    updatemenus = list(
        list(type='buttons',
                direction = "right",
                yanchor = "bottom",
                x = 1,
                y = 0,
                buttons=list(
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "basic")),
                      label = "Basic"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "dark")),
                      label = "Dark"),
                  
                  list(method = "relayout",
                      args = list(list(mapbox.style = "satellite")),
                      label = "Satellite")
                  )
             ))
    ) %>%
  
  animation_opts(
    100, easing = "elastic", redraw = T
  ) %>%
  
     add_annotations(text = "Hold Ctrl to change pitch and bearing",
                     xref = "paper", yref = "paper",
                     x = 0, xanchor = "left",
                     y = 0, yanchor = "top",
                     legendtitle = TRUE,
                     showarrow = FALSE,
                     font = list(color = '#264E86',
                              family = 'sans serif',
                              size = 14))

neighboors=NA
for( i in unique(nyc_squirrels$date)){

date <- nyc_squirrels %>% filter(date==i)
  sp.mydata <- date 
  coordinates(sp.mydata) <- ~long+lat
  d <- distm(sp.mydata)
  min.d <- apply(d, 1, function(x) order(x, decreasing=F)[2])
  newdata <- cbind(date, date[min.d,], apply(d, 1, function(x) sort(x, decreasing=F)[2]))
 
  colnames(newdata) <- c(colnames(date), colnames(date), 'distance')
  
  neighboors <- rbind(neighboors,newdata[,c(3,6,8,9,39,44,45,73)])
}

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

## Warning in .pointsToMatrix(x): Coordinate reference system of SpatialPoints
## object is not set. Assuming it is degrees (longitude/latitude)!

for_neighbor_plot <- as.data.frame(cbind("pair" = c("Same Age", "Both Adults", "Both Juveniles", "Same Fur", "Both Black Fur", "Both Gray Fur", "Both Cinnamon Fur"),
                            "freq" = c(length(which(neighboors$age==neighboors$age.1))/nrow(neighboors),
                            length(which(neighboors$age==neighboors$age.1 & neighboors$age=="Adult"))/length(which(neighboors$age=="Adult")),
                            length(which(neighboors$age==neighboors$age.1 & neighboors$age=="Juvenile"))/length(which(neighboors$age=="Juvenile")),
                            length(which(neighboors$primary_fur_color==neighboors$primary_fur_color.1))/nrow(neighboors),
                            length(which(neighboors$primary_fur_color==neighboors$primary_fur_color.1 & neighboors$primary_fur_color.1=="Black"))/length(which(neighboors$primary_fur_color=="Black")),
                            length(which(neighboors$primary_fur_color==neighboors$primary_fur_color.1 & neighboors$primary_fur_color.1=="Gray"))/length(which(neighboors$primary_fur_color=="Gray")),
                            length(which(neighboors$primary_fur_color==neighboors$primary_fur_color.1 & neighboors$primary_fur_color.1=="Cinnamon"))/length(which(neighboors$primary_fur_color=="Cinnamon"))),
                            
                            "avg.dist"= c(NA, mean(neighboors$distance[which(neighboors$age=="Adult")]),
                                          mean(neighboors$distance[which(neighboors$age=="Juvenile")]),
                                          NA,
                                          mean(neighboors$distance[which(neighboors$primary_fur_color=="Black")]),
                                          mean(neighboors$distance[which(neighboors$primary_fur_color=="Gray")]),
                                          mean(neighboors$distance[which(neighboors$primary_fur_color=="Cinnamon")]))
                                              
                            ))

for_neighbor_plot <- for_neighbor_plot %>% mutate(freq=as.numeric(as.character(freq)))
for_neighbor_plot$pair <-  factor(for_neighbor_plot$pair, levels = c("Same Age", "Both Adults", "Both Juveniles", "Same Fur", "Both Black Fur", "Both Gray Fur", "Both Cinnamon Fur"))

                            
for_neighbor_plot %>% 
  
  plot_ly() %>%
    add_trace(x=~pair, y=~freq, type = 'bar',
          #marker = list(color=c('green1', 'green2','green3', 'black', 'grey4', 'grey3', 'tan3')),
          text=~round(as.numeric(as.character(avg.dist)),2), textposition='auto') %>%
  
  layout(title="Nearest Neighbor Similarity Frequency",
         yaxis= list(title="Frequency of Occurance", range=c(0,1)),
         xaxis= list(title="")
  
  ) ##ADD ANNOTATIONS OF MEAN NEAREST NEIGHBOR

neighboors %>% filter(!is.na(age)) %>%
  plot_ly(y=~distance,
          x=~age,
          type='violin',
          color=~primary_fur_color,
          colors=c('grey4','tan3','grey','purple'),
          text=~paste0("</br>", unique_squirrel_id)
  ) %>%
  layout(
    title='Nearest Neighbor Distance',
    yaxis=list(title='Distance from closest neighbor (m)'),
    xaxis=list(title='Age Class')
  )

neighboors %>% filter(!is.na(age)) %>%
  plot_ly(y=~distance,
          x=~primary_fur_color,
          type='violin',
          color=~age,
          colors=c('grey4','tan3','grey','purple'),
          text=~paste0("</br>", unique_squirrel_id)
  ) %>%
  layout(
    title='Nearest Neighbor Distance',
    yaxis=list(title='Distance from closest neighbor (m)'),
    xaxis=list(title='Primary Fur Color')
  )

nyc_squirrels %>% mutate(date=as.factor(date)) %>% group_by(date, shift) %>% summarise(n=n()) %>%
  plot_ly(labels = ~shift, 
          values = ~n,
          marker=list(colors=c('rgb(255,215,0)','rgb(30,30,30)')),
          frame=~date) %>%
  add_pie(hole = 0.4) %>%
  layout(title = "Daily counts per Shift",  showlegend = T,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

nyc_squirrels %>% mutate(date=as.factor(date)) %>% group_by(date, primary_fur_color) %>% summarise(n=n()) %>%
  plot_ly(labels = ~primary_fur_color, values = ~n, frame=~date, marker=list(colors=c('rgb(30,30,30)','rgb(205,133,63)','rgb(100,100,100)','rgb(160,32,240)'))) %>%
  add_pie(hole = 0.4) %>%
  layout(title = "Daily Proportions of Primary Fur Color",  showlegend = T,
         xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
         yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))